home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tptc16.zip / TPCMISC.INC < prev    next >
Text File  |  1993-01-04  |  2KB  |  92 lines
  1.  
  2. (*
  3.  * TPTC - Turbo Pascal to C translator
  4.  *
  5.  * (C) 1988 Samuel H. Smith (rev. 13-Feb-88)
  6.  *
  7.  *)
  8.  
  9.  
  10. (********************************************************************)
  11. procedure error (message:       anystring);
  12.    {place an error message into the object file and on the screen}
  13.  
  14.    procedure report(var fd: text);
  15.    begin
  16.       writeln(fd);
  17.       writeln(fd,'/* TPTC: ', message,
  18.            ', token="', tok,
  19.            '", source line ',srclines[level],' */');
  20.    end;
  21.  
  22. begin
  23.    write(con,srcfiles[level],'(',srclines[level],')          ');
  24.    report(con);
  25.    report(ofd[level]);
  26. end;
  27.  
  28.  
  29. (********************************************************************)
  30. procedure syntax (message:       anystring);
  31.    {report a syntax error and skip to the next ';'}
  32. begin
  33.    error(message);
  34.  
  35.    while ltok <> ';' do
  36.       gettok;
  37.  
  38.    gettok;
  39. end;
  40.  
  41.  
  42. (********************************************************************)
  43. procedure abortcheck;
  44.    {check for the abort(escape) key}
  45. var
  46.    c:             char;
  47.  
  48. begin
  49.    flush(output);
  50.  
  51.    if keypressed then
  52.    begin
  53.       c := readkey;
  54.  
  55.       if c = #27 then
  56.       begin
  57.          error('Aborted by <escape> key');
  58.          close(ofd[level]);
  59.          halt;
  60.       end;
  61.    end;
  62. end;
  63.  
  64.  
  65. (********************************************************************)
  66. procedure puttok;
  67.    {output the current token and a space to the output}
  68. begin
  69.    write(ofd[level],ltok,' ');
  70. end;
  71.  
  72.  
  73. (********************************************************************)
  74. procedure newline;
  75.    {start a new line in the output file;  indent to the same level
  76.     as the current line}
  77. begin
  78.    writeln(ofd[level]);
  79.    write(ofd[level],spaces);
  80. end;
  81.  
  82.  
  83. (********************************************************************)
  84. procedure endfile;
  85.    {report that unexpected end-of-file has been seen}
  86. begin
  87.    error('No main block');
  88.    close(ofd[level]);
  89.    halt;
  90. end;
  91.  
  92.